home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 04 - 1988 / 04.05 May 88 / LSP PalFun Stuff / PalFunStuff < prev   
Encoding:
Text File  |  1988-04-14  |  18.0 KB  |  789 lines  |  [TEXT/PJMM]
  1. UNIT PalFunStuff;
  2.  
  3. INTERFACE
  4.  
  5.     USES
  6.         ROM85, ColorQuickDraw, ColorWindowMgr, PaletteMgr, PickerIntf, PalFunGlobals;
  7.  
  8.     FUNCTION ColorQDExists : boolean;
  9.  
  10.     PROCEDURE AnimBall;
  11.     PROCEDURE AnimShape;
  12.     PROCEDURE AnimRainbow;
  13.     PROCEDURE AnimFade;
  14.  
  15.     PROCEDURE MakeRed;
  16.     PROCEDURE MakeGreen;
  17.     PROCEDURE MakeBlue;
  18.     PROCEDURE MakeBall;
  19.     PROCEDURE MakeCur;
  20.     PROCEDURE MakeShape;
  21.     PROCEDURE MakeRainbow;
  22.     PROCEDURE MakeFade;
  23.  
  24.     PROCEDURE DoRedUpdate;
  25.     PROCEDURE DoGreenUpdate;
  26.     PROCEDURE DoBlueUpdate;
  27.     PROCEDURE DoCurUpdate;
  28.     PROCEDURE DoBallUpdate;
  29.     PROCEDURE DoShapeUpdate;
  30.     PROCEDURE DoRainbowUpdate;
  31.     PROCEDURE DoFadeUpdate;
  32.  
  33. IMPLEMENTATION
  34.  
  35.  
  36. {******************** General Tools ********************}
  37.  
  38. {Returns true if the Mac had Color Quickdraw.}
  39.     FUNCTION ColorQDExists; {boolean}
  40.         CONST
  41.             ROM85Loc = $28E;
  42.             TwoHighMask = $C000;
  43.         TYPE
  44.             WordPtr = ^INTEGER;
  45.         VAR
  46.             Wd : WordPtr;
  47.     BEGIN
  48.         Wd := POINTER(ROM85Loc);
  49.         ColorQDExists := (BitAnd(Wd^, TwoHighMask) = 0);
  50.     END;
  51.  
  52. {Stuffs Red, Green & Blue into RGBColor}
  53.     PROCEDURE SetRGB (VAR RGB : RGBColor;
  54.                                     R, G, B : INTEGER);
  55.     BEGIN
  56.         RGB.Red := R;
  57.         RGB.Green := G;
  58.         RGB.Blue := B;
  59.     END;
  60.  
  61. {Copies RGBColor into RGBColor}
  62.     PROCEDURE CopyRGB (RGBsrc : RGBColor;
  63.                                     VAR RGBdest : RGBColor);
  64.     BEGIN
  65.         RGBdest.Red := RGBsrc.Red;
  66.         RGBdest.Green := RGBsrc.Green;
  67.         RGBdest.Blue := RGBsrc.Blue;
  68.     END;
  69.  
  70. {Delays a set length time.  usually until}
  71. { the screen in refreshed (prevents ripples)}
  72.     PROCEDURE DoDelay (N : INTEGER);
  73.         VAR
  74.             L : LONGINT;
  75.     BEGIN
  76.         L := TickCount + N;
  77.         WHILE L > TickCount DO
  78.             ;
  79.     END;
  80.  
  81. {Using 16 Bit Unsigned Integers: C:=A/B}
  82.     PROCEDURE UnSignedDiv (A, B : INTEGER;
  83.                                     VAR C : INTEGER);
  84.         VAR
  85.             L : LongInt;
  86.     BEGIN
  87.         IF A < 0 THEN
  88.             L := A + 65536
  89.         ELSE
  90.             L := A;
  91.         C := LoWord(L DIV B);
  92.     END;
  93.  
  94. {Using 16 Bit Unsigned Integers: A:=A+B}
  95.     PROCEDURE UnSignedAdd (VAR A : INTEGER;
  96.                                     B : INTEGER);
  97.         VAR
  98.             L : LongInt;
  99.     BEGIN
  100.         IF A < 0 THEN
  101.             L := A + 65536 + B
  102.         ELSE
  103.             L := A + B;
  104.         A := LoWord(L);
  105.     END;
  106.  
  107. {Using 16 Bit Unsigned Integers: A:=A-B}
  108.     PROCEDURE UnSignedSub (VAR A : INTEGER;
  109.                                     B : INTEGER);
  110.         VAR
  111.             L : LongInt;
  112.     BEGIN
  113.         IF A < 0 THEN
  114.             L := A + 65536 - B
  115.         ELSE
  116.             L := A - B;
  117.         A := integer(LoWord(L));
  118.     END;
  119.  
  120. {******************** Color Table Tools ********************}
  121.  
  122. {Given number of Colors to be placed in it, creates a blank CLUT.  Gives it}
  123. {    an unique Seed and correct value, but no colors.}
  124.     FUNCTION NewCT (N : integer) : CTabHandle;
  125.         VAR
  126.             MyCT : MyCTabHandle;
  127.             count : integer;
  128.     BEGIN
  129.         MyCT := NIL;
  130.         IF (N > 0) AND (N <= MaxCT) THEN
  131.             BEGIN
  132.                 MyCT := POINTER(NewHandle((N * SIZEOF(ColorSpec)) + (2 * SIZEOF(integer)) + SIZEOF(longint)));
  133.                 IF MyCT <> NIL THEN
  134.                     WITH MyCT^^ DO
  135.                         BEGIN
  136.                             ctSeed := GetCTSeed;
  137.                             ctFlag := 0;
  138.                             ctSize := N - 1;
  139.                             FOR count := 0 TO N - 1 DO
  140.                                 WITH ctTable[count] DO
  141.                                     BEGIN
  142.                                         value := count;
  143.                                         SetRGB(rgb, 0, 0, 0);
  144.                                     END;
  145.                         END;
  146.             END;
  147.         NewCT := POINTER(MyCT);
  148.     END;
  149.  
  150. {Stuffs an RGB value in the Nth Color (numbered 0 to N) of the CLUT.}
  151.     PROCEDURE SetCTEntry (C : CTabHandle;
  152.                                     N, R, G, B : INTEGER);
  153.         VAR
  154.             MyCT : MyCTabHandle;
  155.     BEGIN
  156.         MyCT := POINTER(C);
  157.         SetRGB(MyCT^^.ctTable[n].rgb, R, G, B);
  158.     END;
  159.  
  160. {******************** Red ********************}
  161.  
  162. {Red Window displays encompassing red-shaded circles.}
  163. {This creates a 3-D Globe effect.}
  164.  
  165. {Create Red Window/Palette with NewPalette & SetEntryColor commands.}
  166.     PROCEDURE MakeRed;
  167.         VAR
  168.             tempRect : rect;
  169.             tempRGB : RGBColor;
  170.             S : str255;
  171.             count : integer;
  172.     BEGIN
  173.         SetRect(tempRect, 20, 40, 320, 340);
  174.         GetIndString(S, StrID, 1);
  175.         MyWindow[redW] := NewCWindow(NIL, tempRect, S, true, noGrowDocProc, POINTER(-1), true, 0);
  176.  
  177.         MyPalette[redW] := NewPalette(128, NIL, pmTolerant, 0);
  178.         SetRGB(tempRGB, ColorStart, 0, 0);
  179.         FOR count := 0 TO 127 DO
  180.             BEGIN
  181.                 SetEntryColor(MyPalette[redW], count, tempRGB);
  182.                 UnSignedSub(tempRGB.red, ColorInc);
  183.             END;
  184.  
  185.         SetPalette(MyWindow[redW], MyPalette[redW], true);
  186.     END;
  187.  
  188. {Draw the Red Window using RGBForeColor.}
  189.     PROCEDURE DoRedUpdate;
  190.         VAR
  191.             tempRect : rect;
  192.             tempRGB : RGBColor;
  193.             count : integer;
  194.     BEGIN
  195.         SetRect(tempRect, 22, 22, 278, 278);
  196.         SetRGB(tempRGB, ColorStart, 0, 0);
  197.         FOR count := 0 TO 127 DO
  198.             BEGIN
  199.                 RGBForeColor(tempRGB);
  200.                 PaintOval(tempRect);
  201.                 InsetRect(tempRect, 1, 1);
  202.                 UnSignedSub(tempRGB.red, ColorInc);
  203.             END;
  204.     END;
  205.  
  206. {******************** Green ********************}
  207.  
  208. {Green Window displays a Green Globe.}
  209.  
  210. {Create Green Window/Palette with NewPalette command & CLUT  procedures.}
  211.     PROCEDURE MakeGreen;
  212.         VAR
  213.             tempRect : rect;
  214.             tempRGB : RGBColor;
  215.             tempCT : CTabHandle;
  216.             Col : INTEGER;
  217.             S : str255;
  218.             count : integer;
  219.     BEGIN
  220.         SetRect(tempRect, 40, 60, 340, 360);
  221.         GetIndString(S, StrID, 2);
  222.         MyWindow[greenW] := NewCWindow(NIL, tempRect, S, true, noGrowDocProc, POINTER(-1), true, 0);
  223.  
  224.         tempCT := NewCT(128);
  225.         Col := ColorStart;
  226.         FOR count := 0 TO 127 DO
  227.             BEGIN
  228.                 SetCTEntry(tempCT, count, 0, Col, 0);
  229.                 UnSignedSub(Col, ColorInc);
  230.             END;
  231.         MyPalette[greenW] := NewPalette(128, tempCT, pmTolerant, 0);
  232.         DisposHandle(Handle(tempCT));
  233.  
  234.         SetPalette(MyWindow[greenW], MyPalette[greenW], true);
  235.     END;
  236.  
  237. {Draw the Green Window using PmForeColor.}
  238.     PROCEDURE DoGreenUpdate;
  239.         VAR
  240.             tempRect : rect;
  241.             count : integer;
  242.     BEGIN
  243.         SetRect(tempRect, 22, 22, 278, 278);
  244.         FOR count := 0 TO 127 DO
  245.             BEGIN
  246.                 PmForeColor(count);
  247.                 PaintOval(tempRect);
  248.                 InsetRect(tempRect, 1, 1);
  249.             END;
  250.     END;
  251.  
  252. {******************** Blue ********************}
  253.  
  254. {Display a Blue Globe (like Green Window), but now the colors }
  255. {are set up for better displaying (ie. Color Priority).}
  256.  
  257. {Create Green Window/Palette with NewPalette command & CLUT  procedures.}
  258.  
  259.     PROCEDURE MakeBlue;
  260.         VAR
  261.             tempRect : rect;
  262.             tempRGB : RGBColor;
  263.             tempCT : CTabHandle;
  264.             Col : INTEGER;
  265.             S : str255;
  266.             h, v : integer;
  267.     BEGIN
  268.         SetRect(tempRect, 60, 80, 360, 380);
  269.         GetIndString(S, StrID, 3);
  270.         MyWindow[blueW] := NewCWindow(NIL, tempRect, S, true, noGrowDocProc, POINTER(-1), true, 0);
  271.  
  272.         tempCT := NewCT(128);
  273.         Col := ColorStart;
  274.         FOR h := 0 TO 15 DO
  275.             FOR v := 0 TO 7 DO
  276.                 BEGIN
  277.                     SetCTEntry(tempCT, (v * 16) + h, 0, 0, Col);
  278.                     UnSignedSub(Col, ColorInc);
  279.                 END;
  280.         MyPalette[blueW] := NewPalette(128, tempCT, pmTolerant, 0);
  281.         DisposHandle(Handle(tempCT));
  282.  
  283.         SetPalette(MyWindow[blueW], MyPalette[blueW], true);
  284.     END;
  285.  
  286. {Draw the Blue Window using RGBForeColor.}
  287.     PROCEDURE DoBlueUpdate;
  288.         VAR
  289.             tempRect : rect;
  290.             tempRGB : RGBColor;
  291.             count : integer;
  292.     BEGIN
  293.         SetRect(tempRect, 22, 22, 278, 278);
  294.         SetRGB(tempRGB, 0, 0, ColorStart);
  295.         FOR count := 0 TO 127 DO
  296.             BEGIN
  297.                 RGBForeColor(tempRGB);
  298.                 PaintOval(tempRect);
  299.                 InsetRect(tempRect, 1, 1);
  300.                 UnSignedSub(tempRGB.Blue, ColorInc);
  301.             END;
  302.     END;
  303.  
  304. {******************** Current Color ********************}
  305.  
  306. {Displays the Current Color Enviroment}
  307.  
  308. {Create the current Color Window using Explicit colors }
  309. {(Does not have to set the colors).}
  310.     PROCEDURE MakeCur;
  311.         VAR
  312.             tempRect : rect;
  313.             S : str255;
  314.     BEGIN
  315.         SetRect(tempRect, 100, 80, 420, 400);
  316.         GetIndString(S, StrID, 4);
  317.         MyWindow[curW] := NewCWindow(NIL, tempRect, S, true, noGrowDocProc, POINTER(-1), true, 0);
  318.         MyPalette[curW] := NewPalette(256, NIL, pmExplicit, 0);
  319.         SetPalette(MyWindow[curW], MyPalette[curW], true);
  320.     END;
  321.  
  322. {Draws the current Graphic Device Colors.}
  323.     PROCEDURE DoCurUpdate;
  324.         VAR
  325.             x, y, n : integer;
  326.             tempRect : rect;
  327.     BEGIN
  328.         n := 0;
  329.         FOR y := 0 TO 15 DO
  330.             FOR x := 0 TO 15 DO
  331.                 BEGIN
  332.                     PmForeColor(n);
  333.                     SetRect(tempRect, x * 20, y * 20, (x + 1) * 20, (y + 1) * 20);
  334.                     PaintRect(tempRect);
  335.                     n := n + 1;
  336.                 END;
  337.     END;
  338.  
  339. {******************** Ball ********************}
  340.  
  341. {Simple Palette Animation of a Ball Across the Screen}
  342.  
  343. {Create the Ball Animation Window using Animated colors.}
  344.     PROCEDURE MakeBall;
  345.         VAR
  346.             tempRect : rect;
  347.             tempRGB : RGBColor;
  348.             S : str255;
  349.             count : integer;
  350.     BEGIN
  351.         SetRect(tempRect, 100, 120, 400, 420);
  352.         GetIndString(S, StrID, 5);
  353.         MyWindow[ballW] := NewCWindow(NIL, tempRect, S, true, noGrowDocProc, POINTER(-1), true, 0);
  354.         MyPalette[ballW] := NewPalette(19, NIL, pmAnimated, 0);
  355.  
  356.         SetRGB(tempRGB, $FFFF, $FFFF, $FFFF);
  357.         SetEntryColor(MyPalette[ballW], 0, tempRGB);
  358.         SetRGB(tempRGB, 0, 0, 0);
  359.         SetEntryColor(MyPalette[ballW], 1, tempRGB);
  360.         tempRGB.blue := $FFFF;
  361.         SetEntryColor(MyPalette[ballW], 2, tempRGB);
  362.         tempRGB.blue := 0;
  363.         tempRGB.red := $FFFF;
  364.         FOR count := 3 TO 18 DO
  365.             SetEntryColor(MyPalette[ballW], count, tempRGB);
  366.         SetPalette(MyWindow[ballW], MyPalette[ballW], true);
  367.     END;
  368.  
  369. {Draw the Balls in the window using PmForeColor.}
  370.     PROCEDURE DoBallUpdate;
  371.         VAR
  372.             R : rect;
  373.             count : integer;
  374.     BEGIN
  375.         SetRect(R, 0, 0, 10000, 10000);
  376.         PmForeColor(18);
  377.         PaintRect(R);
  378.  
  379.         FOR count := 2 TO 17 DO
  380.             BEGIN
  381.                 R.top := 16 * count;
  382.                 R.left := R.top;
  383.                 R.bottom := R.top + 16;
  384.                 R.right := R.bottom;
  385.                 PmForeColor(count);
  386.                 PaintOval(R);
  387.             END;
  388.     END;
  389.  
  390. {Animate the Ball through the window using AnimateEntry.}
  391.     PROCEDURE AnimBall;
  392.         VAR
  393.             R, B : RGBcolor;
  394.             time, count, temp : integer;
  395.     BEGIN
  396.         SetRGB(R, $FFFF, 0, 0);
  397.  
  398.         SetRGB(B, 0, 0, $FFFF);
  399.  
  400.         FOR time := 1 TO 10 DO
  401.             FOR count := 2 TO 17 DO
  402.                 BEGIN
  403.                     IF count = 17 THEN
  404.                         temp := 2
  405.                     ELSE
  406.                         temp := count + 1;
  407.                     DoDelay(1);
  408.                     AnimateEntry(MyWindow[ballW], count, R);
  409.                     AnimateEntry(MyWindow[ballW], temp, B);
  410.                 END;
  411.     END;
  412.  
  413. {******************** Shape ********************}
  414.  
  415. {Given 3 arbitrary regions (Black/White images), calculates how}
  416. {to draw the window so that the images can be shuffled through}
  417. {{quickly.}
  418.  
  419. {Create the Shape Animation Window}
  420. {('pltt' is automatically loaded in).}
  421.     PROCEDURE MakeShape;
  422.     BEGIN
  423.         MyWindow[shapeW] := GetNewCWindow(ShapeID, NIL, POINTER(-1));
  424.     END;
  425.  
  426. {Draws Shape.  aRgn,bRgn,cRgn are the arbitrary images.}
  427.     PROCEDURE DoShapeUpdate;
  428.         VAR
  429.             aRgn, bRgn, cRgn, TempRgn : RgnHandle;
  430.             count : INTEGER;
  431.             TempRect : Rect;
  432.         PROCEDURE DrawTriag (h, v : INTEGER);
  433.         BEGIN
  434.             MoveTo(h + 25, v);
  435.             Line(-25, 50);
  436.             Line(50, 0);
  437.             Line(-25, -50);
  438.         END;
  439.     BEGIN
  440.         aRgn := NewRgn;
  441.         OpenRgn;
  442.         SetRect(tempRect, 10, 10, 60, 60);
  443.         FrameOval(tempRect);
  444.         SetRect(tempRect, 120, 10, 170, 60);
  445.         FrameRect(tempRect);
  446.         SetRect(tempRect, 120, 80, 170, 130);
  447.         FrameRect(tempRect);
  448.         SetRect(tempRect, 190, 10, 240, 60);
  449.         FrameRect(tempRect);
  450.         SetRect(tempRect, 190, 80, 240, 130);
  451.         FrameRect(tempRect);
  452.         SetRect(tempRect, 10, 80, 110, 81);
  453.         FOR count := 1 TO 25 DO
  454.             BEGIN
  455.                 FrameRect(tempRect);
  456.                 OffSetRect(tempRect, 0, 2);
  457.             END;
  458.         CloseRgn(aRgn);
  459.         bRgn := NewRgn;
  460.         OpenRgn;
  461.         SetRect(tempRect, 35, 10, 85, 60);
  462.         FrameOval(tempRect);
  463.         SetRect(tempRect, 120, 10, 170, 60);
  464.         FrameOval(tempRect);
  465.         SetRect(tempRect, 120, 80, 170, 130);
  466.         FrameOval(tempRect);
  467.         SetRect(tempRect, 190, 10, 240, 60);
  468.         FrameOval(tempRect);
  469.         SetRect(tempRect, 190, 80, 240, 130);
  470.         FrameOval(tempRect);
  471.         SetRect(tempRect, 10, 80, 11, 130);
  472.         FOR count := 1 TO 25 DO
  473.             BEGIN
  474.                 FrameRect(tempRect);
  475.                 OffSetRect(tempRect, 4, 0);
  476.             END;
  477.         CloseRgn(bRgn);
  478.         cRgn := NewRgn;
  479.         OpenRgn;
  480.         SetRect(tempRect, 60, 10, 110, 60);
  481.         FrameOval(tempRect);
  482.         DrawTriag(120, 10);
  483.         DrawTriag(120, 80);
  484.         DrawTriag(190, 10);
  485.         DrawTriag(190, 80);
  486.         MoveTo(60, 80);
  487.         Line(50, 25);
  488.         Line(-50, 25);
  489.         Line(-50, -25);
  490.         Line(50, -25);
  491.         CloseRgn(cRgn);
  492.         TempRgn := NewRgn;
  493.  
  494. {This Region will always be Red (Background)}
  495.         PmForeColor(0);
  496.         SetRect(tempRect, -32000, -32000, 32000, 32000);
  497.         PaintRect(tempRect);
  498.  
  499. {This region will start Blue, change Red, stay Red}
  500.         PmForeColor(1);
  501.         DiffRgn(aRgn, bRgn, TempRgn);
  502.         DiffRgn(TempRgn, cRgn, TempRgn);
  503.         PaintRgn(TempRgn);
  504.  
  505. {This region will be Red,Blue,Red}
  506.         PmForeColor(2);
  507.         DiffRgn(bRgn, aRgn, TempRgn);
  508.         DiffRgn(TempRgn, cRgn, TempRgn);
  509.         PaintRgn(TempRgn);
  510.  
  511. {This region will be Blue,Blue,Red}
  512.         PmForeColor(3);
  513.         SectRgn(aRgn, bRgn, TempRgn);
  514.         PaintRgn(TempRgn);
  515.  
  516. {This region will be Red,Red,Blue}
  517.         PmForeColor(4);
  518.         DiffRgn(cRgn, aRgn, TempRgn);
  519.         DiffRgn(TempRgn, bRgn, TempRgn);
  520.         PaintRgn(TempRgn);
  521.  
  522. {This region will be Blue,Red,Blue}
  523.         PmForeColor(5);
  524.         SectRgn(aRgn, cRgn, TempRgn);
  525.         PaintRgn(TempRgn);
  526.  
  527. {This region will be Red,Blue,Blue}
  528.         PmForeColor(6);
  529.         SectRgn(bRgn, cRgn, TempRgn);
  530.         PaintRgn(TempRgn);
  531.  
  532. {This Region will always be Blue}
  533.         PmForeColor(7);
  534.         SectRgn(aRgn, bRgn, TempRgn);
  535.         SectRgn(cRgn, TempRgn, TempRgn);
  536.         PaintRgn(TempRgn);
  537.  
  538.         DisposeRgn(aRgn);
  539.         DisposeRgn(bRgn);
  540.         DisposeRgn(cRgn);
  541.         DisposeRgn(TempRgn);
  542.     END;
  543.  
  544. {Animate the Shape image using AnimatePalette/CLUT resouces.}
  545.     PROCEDURE AnimShape;
  546.         VAR
  547.             count : INTEGER;
  548.             MyCLUT : ARRAY[1..3] OF CTabHandle;
  549.     BEGIN
  550.         FOR count := 1 TO 3 DO
  551.             MyCLUT[count] := GetCTable(count + 300);
  552.  
  553.         DoDelay(1);
  554.         AnimatePalette(MyWindow[shapeW], MyCLUT[2], 0, 0, 8);
  555.         DoDelay(60);
  556.         AnimatePalette(MyWindow[shapeW], MyCLUT[3], 0, 0, 8);
  557.         DoDelay(60);
  558.         AnimatePalette(MyWindow[shapeW], MyCLUT[1], 0, 0, 8);
  559.         DoDelay(50);
  560.  
  561.         FOR count := 1 TO 5 DO
  562.             BEGIN
  563.                 DoDelay(10);
  564.                 AnimatePalette(MyWindow[shapeW], MyCLUT[2], 0, 0, 8);
  565.                 DoDelay(10);
  566.                 AnimatePalette(MyWindow[shapeW], MyCLUT[3], 0, 0, 8);
  567.                 DoDelay(10);
  568.                 AnimatePalette(MyWindow[shapeW], MyCLUT[1], 0, 0, 8);
  569.             END;
  570.  
  571.         DoDelay(60);
  572.  
  573.         FOR count := 1 TO 5 DO
  574.             BEGIN
  575.                 DoDelay(1);
  576.                 AnimatePalette(MyWindow[shapeW], MyCLUT[2], 0, 0, 8);
  577.                 DoDelay(1);
  578.                 AnimatePalette(MyWindow[shapeW], MyCLUT[3], 0, 0, 8);
  579.                 DoDelay(1);
  580.                 AnimatePalette(MyWindow[shapeW], MyCLUT[1], 0, 0, 8);
  581.             END;
  582.  
  583.         FOR count := 1 TO 3 DO
  584.             DisposCTable(MyCLUT[count]);
  585.     END;
  586.  
  587. {******************** Rainbow ********************}
  588.  
  589. {Demonstrates the Rainbow Effect (Rotating Circle,}
  590. {Moving Bands and Expanding Circle).}
  591. {}
  592. {{Create the Rainbow Animation Window.}
  593.     PROCEDURE MakeRainbow;
  594.         VAR
  595.             tempRect : rect;
  596.             tempRGB : RGBColor;
  597.             S : str255;
  598.             tempHSV : HSVColor;
  599.             count : integer;
  600.     BEGIN
  601.         SetRect(tempRect, 50, 160, 590, 400);
  602.         GetIndString(S, StrID, 6);
  603.         MyWindow[rainbowW] := NewCWindow(NIL, tempRect, S, true, noGrowDocProc, POINTER(-1), true, 0);
  604.         MyPalette[rainbowW] := NewPalette(122, NIL, pmAnimated, 0);
  605.  
  606.         SetRGB(tempRGB, $FFFF, $FFFF, $FFFF);
  607.         SetEntryColor(MyPalette[rainbowW], 0, tempRGB);
  608.         SetRGB(tempRGB, 0, 0, 0);
  609.         SetEntryColor(MyPalette[rainbowW], 1, tempRGB);
  610.         tempHSV.saturation := $FFFF;
  611.         tempHSV.value := $FFFF;
  612.         FOR count := 1 TO 120 DO
  613.             BEGIN
  614.                 tempHSV.hue := ($0FFFF * count) DIV 120;
  615.                 HSV2RGB(tempHSV, tempRGB);
  616.                 SetEntryColor(MyPalette[rainbowW], count + 1, tempRGB);
  617.             END;
  618.         SetPalette(MyWindow[rainbowW], MyPalette[rainbowW], true);
  619.     END;
  620.  
  621. {Draws the rays of the Rainbow.}
  622.     PROCEDURE DoRainbowUpdate;
  623.         VAR
  624.             count : INTEGER;
  625.             tempRect, CRect : Rect;
  626.     BEGIN
  627.         SetRect(tempRect, 0, 0, 480, 240);
  628.         PmForeColor(0);
  629.         PaintRect(tempRect);
  630.         SetRect(tempRect, 0, 0, 240, 240);
  631.         SetRect(CRect, 300, 0, 540, 240);
  632.         FOR count := 0 TO 119 DO
  633.             BEGIN
  634.                 PmForeColor(count + 2);
  635.                 PaintArc(tempRect, count * 3, 3);
  636.  
  637.                 MoveTo(240, count);
  638.                 Line(60, 0);
  639.                 MoveTo(240, count + 120);
  640.                 Line(60, 0);
  641.  
  642.                 PaintOval(CRect);
  643.                 InsetRect(CRect, 1, 1);
  644.             END;
  645.     END;
  646.  
  647. {Rotates all the entries in the CLUT one position.}
  648.     PROCEDURE BumpCTEntry (C : CTabHandle);
  649.         VAR
  650.             tempRGB : RGBcolor;
  651.             MyCT : MyCTabHandle;
  652.             count : INTEGER;
  653.     BEGIN
  654.         MyCT := POINTER(C);
  655.         WITH MyCT^^ DO
  656.             BEGIN
  657.                 CopyRGB(ctTable[0].rgb, tempRGB);
  658.  
  659.                 FOR count := 1 TO ctSize DO
  660.                     CopyRGB(ctTable[count].rgb, ctTable[count - 1].rgb);
  661.  
  662.                 CopyRGB(tempRGB, ctTable[ctSize].rgb);
  663.             END;
  664.     END;
  665.  
  666. {Animate the Rainbow using AnimatePalette.  This one}
  667. {creates and manilpulates it's CLUT directly.}
  668.     PROCEDURE AnimRainbow;
  669.         VAR
  670.             count : INTEGER;
  671.             tempRGB : RGBColor;
  672.             tempCT : CTabHandle;
  673.     BEGIN
  674.         tempCT := NewCT(120);
  675.         FOR count := 1 TO 120 DO
  676.             BEGIN
  677.                 GetEntryColor(MyPalette[rainbowW], count + 1, tempRGB);
  678.                 SetCTEntry(tempCT, count - 1, tempRGB.red, tempRGB.green, tempRGB.blue);
  679.             END;
  680.  
  681.         FOR count := 1 TO 360 DO
  682.             BEGIN
  683.                 BumpCTEntry(tempCT);
  684.                 DoDelay(1);
  685.                 AnimatePalette(MyWindow[rainbowW], tempCT, 0, 2, 120);
  686.             END;
  687.         DisposHandle(Handle(tempCT));
  688.     END;
  689.  
  690. {******************** Fade ********************}
  691.  
  692. {Demonstrates the Fade effect}
  693.  
  694. {Create the Fade Animation Window (uses Palette resource).}
  695.     PROCEDURE MakeFade;
  696.     BEGIN
  697.         MyWindow[fadeW] := GetNewCWindow(FadeID, NIL, POINTER(-1));
  698.     END;
  699.  
  700. {Draws Fade window}
  701.     PROCEDURE DoFadeUpdate;
  702.         VAR
  703.             tempRect : Rect;
  704.             count : INTEGER;
  705.     BEGIN
  706.         PmForeColor(0);
  707.         SetRect(tempRect, -32000, -32000, 32000, 32000);
  708.         PaintRect(tempRect);
  709.  
  710.         FOR count := 1 TO 4 DO
  711.             BEGIN
  712.                 PmForeColor(count);
  713.                 SetRect(tempRect, ((count - 1) * 100) + 10, 10, (count * 100) - 10, 90);
  714.                 PaintOval(tempRect);
  715.             END;
  716.  
  717.         FOR count := 5 TO 8 DO
  718.             BEGIN
  719.                 PmForeColor(count);
  720.                 SetRect(tempRect, ((count - 5) * 100) + 10, 110, ((count - 4) * 100) - 10, 190);
  721.                 PaintOval(tempRect);
  722.             END;
  723.     END;
  724.  
  725. {Animate the Fade.}
  726.     PROCEDURE AnimFade;
  727.         CONST
  728.             FadeStep = 60;
  729.         VAR
  730.             count, E : INTEGER;
  731.             Buf, Inc, Start : ARRAY[0..8] OF RGBColor;
  732.     BEGIN
  733.         SetRGB(Buf[0], -1, -1, -1);
  734.         SetRGB(Buf[1], 0, 0, 0);
  735.         SetRGB(Buf[2], -1, 0, 0);
  736.         SetRGB(Buf[3], 0, -1, 0);
  737.         SetRGB(Buf[4], 0, 0, -1);
  738.         SetRGB(Buf[5], 0, -1, -1);
  739.         SetRGB(Buf[6], -1, 0, -1);
  740.         SetRGB(Buf[7], -1, -1, 0);
  741.         SetRGB(Buf[8], 30000, 30000, 30000);
  742.         FOR E := 0 TO 8 DO
  743.             BEGIN
  744.                 CopyRGB(Buf[E], Start[E]);
  745.                 UnSignedDiv(Buf[E].Red, FadeStep, Inc[E].Red);
  746.                 UnSignedDiv(Buf[E].Green, FadeStep, Inc[E].Green);
  747.                 UnSignedDiv(Buf[E].Blue, FadeStep, Inc[E].Blue);
  748.             END;
  749.  
  750.         FOR count := FadeStep - 1 DOWNTO 1 DO
  751.             BEGIN
  752.                 FOR E := 0 TO 8 DO
  753.                     BEGIN
  754.                         DoDelay(1);
  755.                         UnSignedSub(Buf[E].Red, Inc[E].Red);
  756.                         UnSignedSub(Buf[E].Green, Inc[E].Green);
  757.                         UnSignedSub(Buf[E].Blue, Inc[E].Blue);
  758.                         AnimateEntry(MyWindow[fadeW], E, Buf[E]);
  759.                     END;
  760.             END;
  761.  
  762.         DoDelay(1);
  763.         FOR E := 0 TO 8 DO
  764.             BEGIN
  765.                 SetRGB(Buf[E], 0, 0, 0);
  766.                 AnimateEntry(MyWindow[fadeW], E, Buf[E]);
  767.             END;
  768.  
  769.         DoDelay(90);
  770.  
  771.         FOR count := 1 TO FadeStep - 1 DO
  772.             BEGIN
  773.                 FOR E := 0 TO 8 DO
  774.                     BEGIN
  775.                         DoDelay(1);
  776.                         UnSignedAdd(Buf[E].Red, Inc[E].Red);
  777.                         UnSignedAdd(Buf[E].Green, Inc[E].Green);
  778.                         UnSignedAdd(Buf[E].Blue, Inc[E].Blue);
  779.                         AnimateEntry(MyWindow[fadeW], E, Buf[E]);
  780.                     END;
  781.             END;
  782.  
  783.         DoDelay(1);
  784.         FOR E := 0 TO 8 DO
  785.             AnimateEntry(MyWindow[fadeW], E, Buf[E]);
  786.     END;
  787.  
  788.  
  789. END.